home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_7 / issue_09 / adv_basic / !PrintTest / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-04-25  |  6.5 KB  |  239 lines
  1.            >!RunImage
  2.  Program   Test Program For ASCII printing via Printer Drivers
  3. init             
  4.  quit%:
  5.  start of poll loop                         
  6.  "Wimp_Poll",0,bk% 
  7.  reason%
  8.  reason% 
  9.   6   :
  10. button
  11.   9   :
  12. menuselect
  13.  17,18:
  14. message
  15.  19   :
  16. messageack  :
  17.  in this case, bounced messages..
  18.  "Wimp_CloseDown"
  19. button
  20.  bk%!8 
  21.  read button state
  22.  bk%!12=-2 
  23. 5     
  24.  if Menu pressed over iconbar, create menu 
  25. 0     
  26.  "Wimp_CreateMenu",,menu%,!bk%-64,184
  27.  bk%!12 
  28.      
  29. ,       
  30.  <SELECT> used on iconbar icon..
  31.        
  32. SendPrintSave
  33. menuselect
  34.  button%
  35.  "Wimp_GetPointerInfo",,bk%+256
  36.  read button state
  37. (+button%=bk%!264                        
  38.  !bk% 
  39.  quit if item 1 chosen
  40. ,$   quit%=
  41.                       
  42.  re-open menu if Adjust was  pressed
  43.  button%=1 
  44.  "Wimp_CreateMenu",,menu%:
  45. message
  46.  bk%!16 
  47. 4G                                         
  48.  read message action code
  49.  0:quit%=
  50. :                      
  51.  quit if Quit message received
  52. DataSaveAck:                 
  53.  Message_DataSaveAck received
  54. messageack
  55.  bk%!8 = my_ref% 
  56.  Message_PrintSave bounced, !Printers not running so error out
  57.  of program (not very polite)..
  58.  99,"Printers not running!"
  59. string(a%)                        
  60.  convert a null-terminated string into CR-terminated
  61.  ?a%<>0
  62.  a$+=
  63. ?a%:a%+=1
  64.  bk% 511,menu% 75,ind% 255,name% 11
  65. quit%=0:name$="PrintTest"
  66. err%=0
  67.  "OS_ReadVarVal","PrintTest$Dir",bk%,255,0,3 
  68.  ,,i%
  69. bk%?i%=13:dir$=$bk%
  70.  "Wimp_Initialise",200,&4B534154,name$
  71. error:
  72.  "Wimp_OpenTemplate",,dir$+".Templates"
  73. i%=ind%
  74. infohan%=
  75. create("InfoBox")
  76.  "Wimp_CloseTemplate"
  77. W&!bk%=-1:bk%!4=0:bk%!8=0:bk%!12=100
  78. X1bk%!16=68:bk%!20=&3002:$(bk%+24)="!printtest"
  79.  "Wimp_CreateIcon",,bk%
  80. setupmenu(menu%)
  81. setupmenu(m%)
  82.  $m%,num%:len%=
  83. ($m%)-2
  84. _!m%!12=&70207:m%!20=44:m%!24=0
  85. m%+=28:
  86.  i%=1 
  87.  num%
  88.  !m%=-&80*(i%=num%):
  89.  m%!4
  90. b# m%!8=&7009021:
  91.  a$:$(m%+12)=a$
  92. a$>len% len%=
  93.  m%+=24
  94. :menu%!16=16*(len%+1)
  95. create(a$)
  96. $name%=a$
  97.  "Wimp_LoadTemplate",,bk%,i%,ind%+256,-1,name%,0 
  98.  ,,i%
  99.  "Wimp_CreateWindow",,bk% 
  100.  handle%
  101. =handle%
  102. error
  103. report(
  104. $+" - internal error code "+
  105.  "Wimp_CloseDown"
  106. report(a$,x%)
  107. !bk%=1:$(bk%+4)=a$+
  108.  "Wimp_ReportError",bk%,x%,name$
  109.  PrintTest,2,infohan%,Info,-1,Quit
  110.  --- Printing Handling Routines ----------------------------------------
  111. SendPrintSave
  112.  msgblk%,leaf$
  113.  Initiates Printer protocol, causes a Message_DataSaveAck to be
  114.  returned by !Printers if all is ok, else message bounces
  115.  leaf$      = "PrintOut"+
  116. 7msgblk%    = 
  117. _heap_get(256)  :
  118.  get a memory block
  119. =msgblk%!00 = 256               :
  120.  length of message block
  121. 9msgblk%!12 = 0                 :
  122.  myref 0=originating
  123. @msgblk%!16 = &80142            :
  124.  message action (PrintSave)
  125. ?msgblk%!20 = 0                 :
  126.  destination window handle
  127. =msgblk%!24 = 0                 :
  128.  destination icon handle
  129. 3msgblk%!28 = 0                 :
  130.  mouse x coord
  131. 3msgblk%!32 = 0                 :
  132.  mouse y coord
  133. Jmsgblk%!36 = 256               :
  134.  estimated size of file (wild guess!)
  135. 6msgblk%!40 = &FFF              :
  136.  file type (text)
  137. A$(msgblk% + 44) = leaf$        :
  138.  suggested leaf name of file
  139.  "Wimp_SendMessage",18,msgblk%,msgblk%!20,msgblk%!24
  140.  store the unique wimp-generated 'my_ref' so that if the message is
  141.  'bounced' (i.e. !Printers isn't running) we can check when a
  142.  _User_Message_Acknowledge (reason code 19) is received that it really
  143.  is this messages that has been returned unanswered..
  144. my_ref% = msgblk%!8
  145. _heap_release(msgblk%)
  146. DataSaveAck
  147.  name$,file%,msgblk%,a%,b%
  148. 4msgblk% = 
  149. _heap_get(256)  :
  150.  get a memory block
  151. >                            :
  152.  retrieve the full file name
  153. a% = 0 : b% = bk%?(44 + a%)
  154.  b% <> 0
  155.   name$ += 
  156.   a% += 1
  157.   b% = bk%?(44 + a%)
  158.  99,name$
  159. file%   = 
  160. (name$)
  161. # file%,"This is a printer test file.."
  162. # file%,&0D
  163. # file%,27:
  164. # file%,%10000001
  165. # file%,"And now in bold (hopefully!)"
  166. # file%,27:
  167. # file%,%10000000
  168. # file%,"And now bold IS OFF)"
  169. >cond$=
  170. &1F+"9201"                   :
  171.  part of a FWP file!
  172. # file%,cond$
  173. # file%,"And now in CONDENSED HOPEFULLY!"
  174. # file%,27:
  175. # file%,%10000001   :
  176.  Bold on
  177. # file%,"And now in condensed and ";
  178. # file%,27:
  179. # file%,%10001000   :
  180.  Bold off, underline on
  181. # file%,"underlined";
  182. # file%,27:
  183. # file%,%10000000   :
  184.  under off
  185. # file%," (hopefully!)"
  186. # file%
  187. msgblk%!00 = 256
  188. msgblk%!12 = my_ref%
  189. 0msgblk%!16 = 3       :
  190.  reason code DataLoad
  191. ?msgblk%!20 = bk%!20  :
  192.  window handle from original message
  193. ?msgblk%!24 = bk%!24  :
  194.  icon   handle from original message
  195. #msgblk%!36 = 
  196. FileLength(name$)
  197. msgblk%!40 = &FFF
  198. #$(msgblk% + 44)  = name$ + 
  199.  "Wimp_SendMessage",18,msgblk%,bk%!20,bk%!24
  200. _heap_release(msgblk%)
  201.  --- Memory Management Routines ----------------------------------------
  202. _heap_get(size%)
  203.  ptr%,heap%,flags%
  204.  Returns pointer to new memory block unless claim fails
  205.  in which case -1 is returned
  206.  First find start address of RMA..
  207.  "OS_ReadDynamicArea",1 
  208.  heap%
  209.  Now claim memory, trapping errors by using X form of SWI..
  210.  "XOS_Module",6,,,size% 
  211.  ,,ptr%;flags%
  212.  If error occured return -1, else return address of allocated
  213.  block
  214.  (flags% 
  215.  ptr% = -1
  216. = ptr%
  217. _heap_release(
  218.  ptr%)
  219.  maxfree%,nrpages%,flags%
  220.  Returns  0 if block released OK
  221.  Returns -1 if operation failed (i.e. block doesn't exist)
  222.  "XOS_Module",7,,ptr% 
  223.  ;flags%:
  224.  Free the block
  225.  (flags% 
  226.  1) = 0 
  227.  Block was released successfully...
  228.   ptr% = 0
  229.  Error occured trying to free the block, return -1 to signal to the
  230.  program that something went wrong (normally the program would ignore
  231.  this anyway)
  232.   ptr% = -1
  233.  --- File Handling Routines --------------------------------------------
  234. FileLength(object$)
  235.  type%,load_addr%,exec_addr%,length%,atts%,string$
  236.  "OS_File",5,object$ 
  237.  type%,,load_addr%,exec_addr%,length%,atts%
  238. =length%
  239.